home *** CD-ROM | disk | FTP | other *** search
/ Megahits 3 / Megahits 3 (1994)(GTI - Rhein-Main-Soft)(DE)[!].iso / module / utilities / archives / sampex1_2.lha / Sampex.e < prev    next >
Text File  |  1993-07-21  |  8KB  |  342 lines
  1. /*
  2.     Module Sample Extraction Program (C) 1994 Jason Maskell
  3.  
  4.     This source code has not been commented much at all because I know pretty
  5.     much what it does, and maintenance of such a tiny, simple program should not
  6.     be that hard. So this may not be the ideal source for a beginning E
  7.     programmer to study. It probably is not, actually.
  8. */
  9. OPT OSVERSION=37
  10. MODULE 'asl','libraries/asl','utility/tagitem','dos/dos','workbench/startup'
  11. ENUM NOERROR,ER_NOLIBRARY,ER_NOTSUPPORTED,ER_FILENOTFOUND,ER_NOASLREQ,ER_NODIR,
  12.     ER_NOMEM
  13. ENUM FROMCLI,FROMREQ
  14.  
  15. DEF args[3]:LIST,sampname[256]:LIST,sampptr[256]:LIST,samplen[256]:LIST,number,
  16.     req:PTR TO filerequestr,rdargs,sample_path[256]:STRING
  17.  
  18. PROC main()
  19.     DEF mod,filesource,off=0,done,p:PTR TO LONG,work[256]:STRING,wba:PTR TO wbarg
  20.  
  21.     IF (rdargs:=ReadArgs('Source Module(s)/A/M,Destination Dir/A',args,0))>0
  22.         filesource:=FROMCLI ; p:=args[0] ; StrCopy(sample_path,args[1],ALL)
  23.         FreeArgs(rdargs)
  24.     ELSE
  25.         filesource:=FROMREQ
  26.         /* Choose the source file by requester ... */
  27.         IF (aslbase:=OpenLibrary('asl.library',37))=NIL
  28.             error(ER_NOLIBRARY,'asl')
  29.         ENDIF
  30.         IF (req:=AllocAslRequest(ASL_FILEREQUEST,[ASL_HAIL,'Choose Module(s) to extract from',ASL_WIDTH,350,ASL_DIR,'ram:',ASL_FUNCFLAGS,FILF_MULTISELECT,0]:tagitem))>0
  31.             IF AslRequest(req,0)=0
  32.                 req:=FreeAslRequest(req)
  33.                 getout(0)
  34.             ENDIF
  35.             wba:=req.arglist
  36.         ELSE
  37.             error(ER_NOASLREQ,0)
  38.         ENDIF
  39.     ENDIF
  40.  
  41.     REPEAT
  42.         IF filesource=FROMCLI
  43.             IF p[off+1]=0
  44.                 done:=TRUE
  45.             ENDIF
  46.             StrCopy(work,p[off],ALL)
  47.         ELSE
  48.             IF req.numargs=1
  49.                 StrCopy(work,req.dir,ALL)
  50.                 AddPart(work,req.file,256)
  51.                 SetStr(work,StrLen(work))
  52.                 done:=TRUE
  53.             ELSE
  54.                 IF off+1=req.numargs
  55.                     done:=TRUE
  56.                 ENDIF
  57.                 StrCopy(work,req.dir,ALL)
  58.                 AddPart(work,wba.name,256)
  59.                 SetStr(work,StrLen(work)) ; wba:=wba+SIZEOF wbarg
  60.             ENDIF
  61.         ENDIF
  62.         INC off
  63.  
  64.         IF (mod:=testfile(work))>-1
  65.             WriteF('\s Module found.\n',ListItem(['MMD0','MMD1','PT/ST/NT'],mod))
  66.             extract(work,mod)
  67.             savesamples(work)
  68.         ELSE
  69.             error(ER_NOTSUPPORTED,work)
  70.         ENDIF
  71.     UNTIL done=TRUE
  72.     getout(0)
  73. ENDPROC
  74. CHAR '$VER: Sampex V1.1 (C) 1994 Jason Maskell',0
  75. /*
  76.     This procedure tests to see if the file is an MMD1 file, or exists at all..
  77. */
  78. PROC testfile(filename)
  79.     DEF fh,buff:PTR TO LONG
  80.     IF FileLength(filename)>0
  81.         fh:=Open(filename,OLDFILE)
  82.         IF (buff:=New($500))>0
  83.             Read(fh,buff,$43c)
  84.             Close(fh)
  85.             IF buff[]="MMD0"
  86.                 Dispose(buff)
  87.                 RETURN 0
  88.             ENDIF
  89.             IF buff[]="MMD1"
  90.                 Dispose(buff)
  91.                 RETURN 1
  92.             ENDIF
  93.             IF buff[270]="M.K."
  94.                 Dispose(buff)
  95.                 RETURN 2
  96.             ENDIF
  97.         ELSE
  98.             error(ER_NOMEM,0)
  99.         ENDIF
  100.     ELSE
  101.         error(ER_FILENOTFOUND,filename)
  102.     ENDIF
  103. ENDPROC -1
  104. /*
  105.     This procedure handles the actual extraction of samples
  106. */
  107. PROC extract(filename,type)
  108.     DEF a,b,fh,buff,len,p:PTR TO LONG,wp:PTR TO INT,samptr,nameptr,
  109.     slen,totallen,ptr,sstart
  110.  
  111.     len:=FileLength(filename)
  112.     IF (buff:=New(len))>0
  113.         fh:=Open(filename,OLDFILE)
  114.         Read(fh,buff,len) ; p:=buff
  115.         IF type<2
  116.             samptr:=p[6]+buff ; p:=p[8]+buff
  117.             IF p[5]=0
  118.                 WriteF('Instrument names not included!\n')
  119.                 nameptr:=0
  120.             ELSE
  121.                 nameptr:=p[5]+buff
  122.             ENDIF
  123.             wp:=p ; number:=wp[4]
  124.             p:=samptr
  125.             FOR a:=1 TO number
  126.                 slen:=0
  127.                 IF a=number
  128.                     IF p[0]>0
  129.                         slen:=len-p[0]
  130.                     ELSE
  131.                         slen:=0
  132.                     ENDIF
  133.                 ELSE
  134.                     IF p[0]>0
  135.                         IF p[1]>0
  136.                             slen:=p[1]-p[0]
  137.                         ELSE
  138.                             b:=0
  139.                             REPEAT
  140.                                 b++
  141.                                 IF p[b]>0
  142.                                     slen:=p[b]-p[0]
  143.                                 ENDIF
  144.                             UNTIL (b+a>=number) OR (slen>0)
  145.                         ENDIF
  146.                     ELSE
  147.                         slen:=0
  148.                     ENDIF
  149.                 ENDIF
  150.                 IF slen>0
  151.                     sampname[a]:=String(42)
  152.                     IF nameptr>0
  153.                         StrCopy(sampname[a],nameptr,ALL) ; nameptr:=nameptr+42
  154.                     ENDIF
  155.                     WriteF('Sample Name:\s[20] Length:\d\n',sampname[a],slen)
  156.                     sampptr[a]:=New(slen)
  157.                     IF sampptr[a]>0
  158.                         samplen[a]:=slen
  159.                         CopyMem(p[0]+buff,sampptr[a],slen)
  160.                         totallen:=totallen+slen
  161.                     ELSE
  162.                         error(ER_NOMEM,0)
  163.                     ENDIF
  164.                     slen:=0
  165.                 ELSE
  166.                     sampptr[a]:=0 ; samplen[a]:=0
  167.                 ENDIF
  168.                 p[]++
  169.             ENDFOR
  170.         ELSE
  171.             ptr:=buff+20 ; wp:=ptr ; number:=0
  172.             FOR a:=0 TO 30
  173.                 IF wp[11]>0
  174.                     INC number
  175.                     samplen[number]:=wp[11]*2 ; sampname[number]:=String(22) 
  176.                     sampptr[number]:=New(samplen[number])
  177.                     IF sampptr[number]>0
  178.                         StrCopy(sampname[number],wp,ALL)
  179.                         WriteF('Sample Name:\s[20] Length:\d\n',sampname[number],samplen[number])
  180.                         totallen:=totallen+samplen[number]
  181.                     ELSE
  182.                         error(ER_NOMEM,0)
  183.                     ENDIF
  184.                 ENDIF
  185.                  wp:=wp+30
  186.             ENDFOR
  187.             sstart:=(buff+len)-totallen
  188.             FOR a:=1 TO number
  189.                 CopyMem(sstart,sampptr[a],samplen[a])
  190.                 sstart:=sstart+samplen[a]
  191.             ENDFOR
  192.         ENDIF
  193.     ELSE
  194.         error(ER_NOMEM,0)
  195.     ENDIF
  196.     WriteF('\nTotal Length of Samples:\d\n',totallen)
  197.     Close(fh)
  198.     Dispose(buff)
  199. ENDPROC
  200. /*
  201.     This saves the samples...
  202. */
  203. PROC savesamples(modfile)
  204.     DEF req:PTR TO filerequestr,lock,a,work[256]:STRING,result,file[256]:STRING
  205.  
  206.     IF EstrLen(sample_path)=0
  207.         IF (req:=AllocAslRequest(ASL_FILEREQUEST,[ASL_HAIL,'Choose a directory to save samples to',ASL_WIDTH,350,ASL_EXTFLAGS1,FIL1F_NOFILES,ASL_FUNCFLAGS,FILF_SAVE,ASL_DIR,'ram:',0]:tagitem))>0
  208.             IF AslRequest(req,0)>0
  209.                 StrCopy(sample_path,req.dir,ALL)
  210.                 FreeAslRequest(req)
  211.             ELSE
  212.                 WriteF('Save Aborted!\n')
  213.                 FreeAslRequest(req)
  214.                 getout(0)
  215.             ENDIF
  216.         ELSE
  217.             error(ER_NOASLREQ,0)
  218.         ENDIF
  219.     ENDIF
  220.  
  221.     IF (lock:=Lock(sample_path,SHARED_LOCK))>0
  222.         UnLock(lock)
  223.         FOR a:=1 TO number
  224.             IF samplen[a]>0
  225.                 IF CtrlC()
  226.                     getout(0)
  227.                 ENDIF
  228.                 IF EstrLen(sampname[a])=0
  229.                     StringF(work,'\s.UNSamp.\d',FilePart(modfile),a)
  230.                     StrCopy(sampname[a],work,ALL)
  231.                 ENDIF
  232.                 cleanupstring(sampname[a])
  233.                 StrCopy(work,sample_path,ALL)
  234.                 AddPart(work,sampname[a],ALL) ; SetStr(work,StrLen(work))
  235.                 IF FileLength(work)=-1
  236.                     savesamp(a,work)
  237.                 ELSE
  238.                     StringF(file,'File "\s" already exists\nOn Disk Size :\d\nNew File Size:\d',work,FileLength(work),samplen[a])
  239.                     result:=request('Extract Requester',file,'OverWrite|Rename|Cancel',0)
  240.                     IF result=1
  241.                         savesamp(a,work)
  242.                     ELSE
  243.                         IF result=2    /* Then rename the file! */
  244.                             IF renamefile(work)>0
  245.                                 savesamp(a,work)
  246.                             ENDIF
  247.                         ENDIF
  248.                     ENDIF
  249.                 ENDIF
  250.                 Dispose(sampptr[a]) ; samplen[a]:=0 ; sampname[a]:=0
  251.             ENDIF
  252.         ENDFOR
  253.     ELSE
  254.         error(ER_NODIR,0)
  255.     ENDIF
  256. ENDPROC
  257. PROC savesamp(sampnum,filename)
  258.     DEF fh
  259.     WriteF('Saving:\s[20] To \s\n',sampname[sampnum],filename)
  260.     IF (fh:=Open(filename,NEWFILE))>0
  261.         Write(fh,sampptr[sampnum],samplen[sampnum])
  262.         Close(fh)
  263.     ELSE
  264.         WriteF('Unable to open file \s\n',sampname[sampnum])
  265.     ENDIF            
  266. ENDPROC
  267. /*
  268.     This procedure changes illegal characters in a string to '.' and removes
  269.     ST-xx: prefixes...
  270. */
  271. PROC cleanupstring(str:PTR TO CHAR)
  272.     DEF a,off=0
  273.     IF (a:=InStr(str,':',0))>-1
  274.         MidStr(str,str,a+1,ALL)
  275.     ENDIF
  276.     REPEAT
  277.         a:=InStr(str,':',off)
  278.         IF a=-1
  279.             a:=InStr(str,'/',off)
  280.         ENDIF
  281.         IF a>-1
  282.             str[a]:="." ; off:=a
  283.         ENDIF
  284.     UNTIL a=-1
  285. ENDPROC
  286.  
  287. PROC renamefile(file)
  288.     DEF req:PTR TO filerequestr
  289.     IF (req:=AllocAslRequest(ASL_FILEREQUEST,[ASL_HAIL,'Save sample as:',ASL_WIDTH,350,ASL_DIR,sample_path,ASL_FILE,FilePart(file),ASL_FUNCFLAGS,FILF_SAVE,0]:tagitem))>0
  290.         IF AslRequest(req,0)>0
  291.             StrCopy(file,req.dir,ALL) ; AddPart(file,req.file,256) ; SetStr(file,StrLen(file))
  292.         ELSE
  293.             FreeAslRequest(req)
  294.             RETURN 0
  295.         ENDIF
  296.     ELSE
  297.         error(ER_NOASLREQ,0)
  298.     ENDIF
  299.     FreeAslRequest(req)
  300. ENDPROC 1
  301. /*
  302.     Good ole clean exit procedure...
  303. */
  304. PROC getout(retcode)
  305.     IF rdargs
  306.         FreeArgs(rdargs)
  307.     ENDIF
  308.     IF req
  309.         FreeAslRequest(req)
  310.     ENDIF
  311.     IF aslbase
  312.         CloseLibrary(aslbase)
  313.     ENDIF
  314.     CleanUp(retcode)
  315. ENDPROC
  316.  
  317. PROC error(err,str)
  318.     DEF work[256]:STRING,retcode=11
  319.     SELECT err
  320.         CASE ER_NOLIBRARY
  321.             StringF(work,'Unable to open \s.library V37+',str)
  322.         CASE ER_NOTSUPPORTED
  323.             StringF(work,'File: "\s"\nIs not a supported module file.\nSupported: MMD0, MMD1, PT/ST/NT',str) ; retcode:=-1
  324.         CASE ER_FILENOTFOUND
  325.             StringF(work,'File "\s" not found.',str)
  326.         CASE ER_NOASLREQ
  327.             StringF(work,'Unable to open Asl Requester...')
  328.         CASE ER_NODIR
  329.             StringF(work,'Unable to lock destination dir...')
  330.         CASE ER_NOMEM
  331.             StringF(work,'Unable to allocate memory...')
  332.         DEFAULT
  333.             StringF(work,'Unknown Error Type')
  334.     ENDSELECT
  335.     request('Extract Error Requester',work,'Ok',0)
  336.     IF retcode>0
  337.         getout(retcode)
  338.     ENDIF
  339. ENDPROC
  340. PROC request(title,body,gadgets,args)
  341. ENDPROC EasyRequestArgs(0,[20,0,title,body,gadgets],0,args)
  342.